when ex='.ZIP' then do;alst='unzip -vUq ';aext='unzip -Uq ';aadd='zip -r ';adel='zip -dq ';aprs="parse var j sz.la +7 +9 gy.la +29 +2 crc +8 +3 na.la;gy.la=insert(' ',gy.la,9)':00'";end
when ex='.LZX' then do;alst='lzx l ';aext='lzx x ';aadd='lzx -a -x a ';adel='lzx d ';aprs="parse var j +1 sz.la +7 +2 gy.la +32 +1 na.la;gy.la=insert(' ',gy.la,24)";end
when ex='.LHA'|ex='.LZH'|ex='.RUN' then do;alst='lha -b64 -m -Qw -Qo v ';aext='lha -I -b64 -m -Qw -Qo x ';aadd='lha -I -b64 -m -Qw -Qo -x u ';adel='lha -I -b64 -m -Qw -Qo d ';aprs="parse var j +1 sz.la +7 +1 gy.la +32 +2 na.la;gy.la=insert(' ',gy.la,24)";end
otherwise do;if ex='.GIF' then do;call UPIC(gvi);exit;end;if lo&ex='.MPG' then do;call UPIC(mvi);exit;end
if ex='.IFF' then do;call UPIC(ivi);exit;end;if ex='.JPG' then do;call UPIC(jvi);exit;end
if ex='.ANI' then do;call UPIC(avi);exit;end;if ex='.PCX' then do;call UPIC(pvi);exit;end
tr 'n1Sorry - viewing of 'ex' is not supported!';exit;end;end
parse var ver 7 p!' 'v!' ' +11 m!;dlp='';li=' ---- -------- ------ ----- --------- -------- ------------------'
call pragma('D',ar);cdir=pragma('D');if right(cdir,1)~=':' then cdir=cdir'/';call makedir(wdir);call pragma('D',wdir);call INIT;mor=BBSLINE(1064)' '
do until gk='NO';la=1;d=7;ud=0;q=0;tr '@6c5n1'p!' v'v!' 'm!' - Flux Point Amiga BBS +45 3526 2527n2c7Listing of archive: c3'fn'n2c7 # Original Packed Ratio Date Time Namen1'li
do while ~ud&la~=hi;if re&la>ti then do;j=readln(fp);interpret(aprs);if substr(sz.la,2,3)='---'|EOF(fp) then do;hi=la;re=0;ud=1;end
if na.la=''|(substr(gy.la,13,1)~='%'&ex~='.LZX')|crc='00000000' then iterate;end;tr '@6'right(la,4)') c2'sz.la gy.la' c7 'translate(substr(' 'na.la,1+lastpos('/',substr(' 'na.la,2))),'+','/')
la=la+1;d=d+1;if ll=d then do;se '@6'mor;gc;ke=CHECK(result);tr '^1';if ke='N' then ud=1;if ke~='C' then d=1;end;end
ti=la-1;query '@61'li'n2c7Item number(s) to VIEW [c2Nonec7]: ';it=CHECK(result);if it='' then do;gk='NO';iterate;end
pn=0;au=PARSE(it,1,ti);do vn=1 to au while ~pn;call ACTION(it.vn);end;dlp='';pr 1 noyes 'n1View archive "c3'fn'c7" again [c2Noc7]? ';gk=CHECK(result);end
if right(so1,1)='01'x&substr(so1,61,1)~='01'x then call delete(cdir||fn);exit
ACTION:;arg nr;dfil=na.nr;select;when mo=6 then do;call CRCAD;call INIT;end;when mo=5&led~='' then do;if UNPACK() then return;call EDFIL;call delete(dpat);call INIT;end
when mo=4 then do;call BBSAD;call INIT;end;when mo=3&adel~='' then do;call DELFIL;call INIT;end;when mo=2&aadd~='' then do;call ADDFIL;call INIT;end
when mo=1 then do;if UNPACK() then return;call DLOAD;call delete(dpat);end;otherwise do;if UNPACK() then return;call IDENT
if vn~=au&~q then do;se 'n2c7Press [c2Qc7] to quit or [c2RETURNc7] to continue.';gc;if CHECK(result)='Q' then pn=1;tr 'n1';end;call delete(dpat);end;end;return
DLOAD:;if ~q then do;pr 1 noyes 'n1Download c3'dfil'c7 [c2Noc7]? ';ke=CHECK(result);if ke='NO' then return;end
if tlo then do;if dlp='' then do;pr 40 normal 'n1Copy to path: ';dlp=CHECK(result);if dlp='' then return;end
tr 'n1Copying c3'dfil'c7 to c3'dlp'c7';address command 'copy "'dpat'" TO "'dlp'"';end;else XDN dpat;return
EDFIL:if ~q then do;pr 1 yesno 'n1c7Edit "c3'dfil'c7" [c2Yesc7]? ';ke=CHECK(result);if ke='NO' then return;end
se 'n1Editing c3'dfil'c7, one moment....';address command led' "'dfil'"';tr 'Done!'
if ~q then do;pr 1 yesno 'n1c7Save "c3'dfil'c7" to "c3'fn'c7" [c2Yesc7]? ';ke=CHECK(result);if ke='NO' then return;end
ADDFIL:;pr 50 normal 'n1c7Enter Path/file to add to archive: ';ake=CHECK(result);if ake='' then return
if ~exists(ake) then do;tr 'n1Error, c3'ake'c7 not found!';signal ADDFIL;end
adc=aadd;if ~q&index(ake,'/')>0 then do;pr 1 yesno 'n1c7Include full path when adding file [c2Yesc7]? ';ke=CHECK(result);if ke='NO' then adc=delstr(adc,index(adc,' -x'),3);end
se 'n1Addingc3 'ake'c7 to c3'fn'c7, one moment....';address command adc'"'cdir||fn'" "'ake'"';tr 'Done!';return
DELFIL:;if ~q then do;pr 1 yesno 'n1c7Delete "c3'dfil'c7" [c2Yesc7]? ';ke=CHECK(result);if ke='NO' then return;end
se 'n1Deleting c3'dfil'c7, one moment....';address command adel'"'cdir||fn'" "'dfil'"';tr 'Done!';return
UNPACK:;if sz.nr>storage()-fmem*1024 then do;tr 'n1Sorry! - file "c3'dfil'c7" is too big to fit into memory!';return 1;end
se 'n1Un-arcing "c3'dfil'c7", one moment....';address command aext'"'cdir||fn'" "'dfil'"';dpat=wdir'/'dfil
if ~exists(dpat) then do;tr 'c1Error!c7 file not found!';return 1;end;tr 'Done!';return 0
if xp&index(id,'Xpk ')>0&index(id,'cry')=0 then do;se 'n1Xpk-packed file, additional decrunching....';address command 'XUP >NIL: "'dpat'"';tr 'Done!';xp=0;signal IDENT2;end
select;when index(id,'Lhar')>0|index(id,'Zip')>0 then signal NEW
when index(id,'n exe')>0|index(id,'n li')>0|index(id,'ce dr')>0 then call VRS
when lo&upper(right(dpat,4))='.ICN' then call RIP
when index(id,'wn dat')>0 then call TXT
when index(id,'Gui')>0 then do;if lo&guv~='' then address command guv' FILE "'dpat'" PUBSCREEN CNETSCREEN'po;else se '#4'gvr' FILE 'dpat' LINES 'll'}f1';end
when lo&index(id,'ve 3')>0|lo&index(id,'Imagine')>0 then call PIC(ovi' PUBSCREEN CNETSCREEN'po)
when lo&index(id,'module')>0&index(id,'TFM')=0&index(id,'pile')=0 then call MOD
when lo&index(id,'MPeg')>0 then call PIC(mvi);when index(id,'PEG')>0 then call PIC(jvi)
when lo&index(id,'ico')>0 then call PIC(icv);when lo&index(id,'d sam')>0 then call SND
when index(id,'IFF p')>0 then call PIC(ivi);;when index(id,'on/a')>0 then call PIC(avi)
when index(id,'PCX')>0 then call PIC(pvi);when index(id,'GIF')>0 then call PIC(gvi)
otherwise tr 'n1c7File Identification for 'dfil': c2'id'c7n1';end;return
VRS:;tr 'n2Version Info for c3'dfil':c7 ('id')';address command 'version FILE >'ifil' "'dpat'" FULL'
if RC=0 then sendfile ifil;else tr 'n1c7Sorry, this file has no Version string! (Bad Coding!!)';return
RIP:;if ~q then do;pr 1 yesno 'n1"c3'dfil'c7" is a RIP-icon, view it [c2Yesc7]? ';ke=CHECK(result);if ke='NO' then return;end
se '#4ICNview "'dpat'"}';return
PIC:;se '#4GFXList "'dpat'"}';if ~lo then return
if ~q then do;pr 1 yesno 'n1"c3'dfil'c7" is a 'id', view it [c2Yesc7]? ';ke=CHECK(result);if ke='NO' then return;end
address command arg(1)' "'dpat'"';return
SND:;if ~q then do;pr 1 yesno 'n1"c3'dfil'c7" is an 'id', play it [c2Yesc7]? ';ke=CHECK(result);if ke='NO' then return;end
address command spl' "'dpat'"';return
MOD:;if ~q then do;pr 1 yesno 'n1"c3'dfil'c7" is a 'id', play it [c2Yesc7]? ';ke=CHECK(result);if ke='NO' then return;end
if ~show('P','DELITRACKER') then do;address command 'RUN >NIL: 'deli' CONFIG S:DELITRACKER.CONFIG CX_POPUP NO PUBSCREEN CNETSCREEN'po
do 1 while ~show('P','DELITRACKER');address command 'waitforport DELITRACKER';end;if RC=5 then do;tr 'n1b1Sorry - unable to load Delitracker!';return;end;end
address 'DELITRACKER';'PUBSCREEN CNETSCREEN'po;'SHOWGUI';'PLAYMOD 'dpat;'STATUS m pnr';address
if result>0 then do;a=0;do a=a+1 until result=dfil|a>100;address 'DELITRACKER' 'STATUS m fil';end;end
else tr 'n1Sorry - No player loaded for Moduletype: c3'word(id,1)'c7';return
if ~q&pc<98 then do;pr 1 noyes 'n1This file is only c3'pc'%c7 ASCII, Type it anyway [c2Noc7]? ';ke=CHECK(result);if ke='NO' then return;end
if index(lamers,ag)>0 then do;call open(pf,dpat,'W');call writeln(pf,a' [BREAK]'||'0a0a'x||' ****** Download the archive, if you want to read more!! ******'||'0a'x)
call close(pf);end;if tvi='' then se 'q1f1*3'dpat'}';else se '#4'tvi' FILE 'dpat' LINES 'll'}f1';return
CRCAD:;if ~q then do;pr 1 yesno 'n1Add the name "c3'dfil'c7" to ENV:'stp' [c2Yesc7]? ';ke=CHECK(result);if ke='NO' then return;end
call open(fp,wfil,'R');do until substr(la,2,3)='---'|EOF(fp);la=readln(fp);end;la=1;return
PARSE:;arg it,min,max;mo=upper(left(it,1));select;when mo='?' then do;mo=0;it=0;call HELP;end;when mo='D'&(sop|sy|index(dag,ag)>0) then do;mo=1;call QUICK;end
when mo='A'&(sy|sop)&(rmo|tlo) then do;mo=2;it=1;end;when mo='K'&(sy|sop) then do;mo=3;call QUICK;end;when mo='B'&(sy|sop)&(rmo|tlo) then do;mo=4;call QUICK;end
when mo='E'&tlo then do;mo=5;call QUICK;end;when mo='C'&(sy|sop)&(rmo|tlo)&(ex='.LHA'|ex='.LZH') then do;mo=6;call QUICK;end;otherwise do;mo=0;call QUICK2;end;end
it.='';c=0;it=translate(it,' ','.,');do a=1 to words(it);c=c+1;it.c=word(it,a)
if index(it.c,'-')>0 then do;parse var it.c x'-'y;if y='' then y=max;if x='' then x=min;if x>y then do;d=x;x=y;y=d;end
if x<min|y>max|~datatype(x,'W')|~datatype(y,'W') then do;c=c-1;iterate;end;do b=x to y;it.c=b;c=c+1;end;c=c-1;end
else if it.c<min|it.c>max|~datatype(it.c,'W') then do;c=c-1;iterate;end;end;return c
QUICK:;it=substr(it,2);QUICK2:;if right(it,1)='!' then do;q=1;it=left(it,length(it)-1);end;return
HELP:;tr 'f1c5n1>8'substr(ver,7)' - Flux Point Amiga BBS +45 3526 2527n2c3 FPAV is a program to display textfiles or fileinfo on files within archives.'
tr ' Input must be in the following format:n2 c2#c7 any item number>nExample: c65n2 c2#-#c7 a RANGE of values>lExample: c66-11c7'
tr 'n1 c2, or .c7 to separate multiple RANGES>bExample: c64,7,9-11n2c3 Additional commands/options:c7'
if sop|sy|index(dag,ag)>0 then tr 'n1 [c2Dc7]ownload file(s) from archive.>dExample: c6D2,4-5c7'
if (sop|sy)&(rmo|tlo) then tr 'n1 [c2Ac7]dd file to archive.>nExample: c6Ac7n2 [c2Bc7]BS-Ad to c1ENV:'left(stp'c7 adding!.',32)'Example: c6B4-5c7'
if tlo then tr'n1 [c2Ec7]dit textfile(s) inside archive. Example: c6E2,5c7'
if (sy|sop) then tr 'n1 [c2Kc7]ill file(s) inside archive.>fExample: c6K4-5c7';tr 'n1c3 If the input range ends in a "c7!c3" (Quick-mode), then FPAV will skip prompts!c7';return
SUBOP:;id1=x2c(d2x(arg(1),8));gu 1209388;su1=result*488+96;gu 2401068;so1=import(x2c(d2x(result+su1,8)),210);sup=0;do a=0 to 5;if id1=substr(so1,a*4+1,4) then sup=1;end;return sup
BBSLINE: procedure;arg li;getuser 1402022;ln=import(import(offset(x2c(d2x(result,8)),(li-1)*4),4),256);parse var ln ln'00'x .;return ln
CHECK:;arg ch;if ch~='###PANIC' then return ch;logentry 'Lost Carrier in FPAV!';bufferflush;exit
IOERR:;SYNTAX:;er='Error in line: 'sigl' Code: 'errortext(rc);tr er;logentry er;bufferflush;exit